home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
ugly174.zip
/
RSB3UGLY.MRG
< prev
next >
Wrap
Text File
|
1992-07-05
|
43KB
|
1,062 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against RELEASE\RBBSSUB3.BAS to produce RBBSSUB3.BAS
* RELEASE\RBBSSUB3.BAS: Date 6-20-1992 Size 129071 bytes
* ------------[ Created 07-04-1992 19:43:38 ]------------
* REPLACING old line(s) by new
20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory'
' $PAGE
' NAME -- UpdtUpload
'
' INPUTS -- PARAMETER MEANING
' ZFileName$
' ZUpldDir$
' ZFileNameHold$
' ZShareIt
' ZFMSDirectory$
' ZWasQ!
' ZSecsUsedSession!
'
' OUTPUTS -- ZBytesInFile#
' ZSecsPerSession!
'
' PURPOSE -- Upon a successful upload, add entry to the upload
' directory and give any session time credit.
'
SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1), LinesInDesc) STATIC
IF ZGetExtDesc THEN _
GOTO 20723
GOSUB 20734
CALL TimeRemain (MinsRemaining)
IF ZPrivateDoor THEN _
WasX! = ZUpldTimeFactor! * ZWasQ! _
ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!)
CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZFalse)
WasX$ = ZDiskForDos$ + "T" + Ext$ + ".BAT"
CALL FindIt (WasX$)
IF NOT ZOK THEN _
GOTO 20708
* ------[ first line different ]------
CALL QuickTPut1 ("Testing Upload. Please Wait...") : _ ' UG070501
CALL ReadDir (2,1)
ZGSRAra$(2) = ZNodeWorkDrvPath$ + "VCHK" + ZNodeFileID$
IF EOF(2) THEN _
WasX$ = ZOutTxt$ : _
ZGSRAra$(1) = ZFileName$ _
ELSE WasX$ = WasX$ + " " + _
ZFileName$ + " " + ZGSRAra$(2)
CALL ShellExit (WasX$)
CALL FindIt (ZGSRAra$(2))
IF ZOK THEN _
IF LOF(2) > 2 THEN _
ZBytesInFile# = 0.0 : _
WasX$ = "Deleting BAD Upload " + ZFileNameHold$ + "." : _' UG070501
CALL QuickTPut1 (WasX$) : _
CALL UpdtCalr (WasX$,2) : _
CALL KillWork (ZFileName$) : _
EXIT SUB
* REPLACING old line(s) by new
20708 WasX$ = ZDiskForDos$ + "C" + Ext$ + ZDefaultExtension$ + ".BAT"
CALL FindIt (WasX$)
IF NOT ZOK THEN _
GOTO 20709
ZOutTxt$ = "Converting"
IF Ext$ = ZDefaultExtension$ THEN _
ZOutTxt$ = "Re-" + ZOutTxt$
* ------[ first line different ]------
CALL QuickTPut1 (ZOutTxt$ + " Upload to "+ZDefaultExtension$+". Please Wait...") ' UG070501
CALL ReadDir (2,1)
IF EOF(2) THEN _
WasX$ = ZOutTxt$
ZGSRAra$(1) = ZFileName$
CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZTrue)
ZFileNameHold$ = Body$ + "." + ZDefaultExtension$
ZUserIn$(0) = ZFileName$
ZFileName$ = Pre$ + ZFileNameHold$
CALL ShellExit (WasX$ + " " + Body$ + " " + ZNodeID$)
CALL FindIt (ZFileName$)
IF NOT ZOK THEN _
ZFileName$ = ZGSRAra$(1) : _
CALL FindIt (ZFileName$) : _
ZFileNameHold$ = Body$ + Ext$ : _
IF ZOK THEN _
GOTO 20709
GOSUB 20736
* REPLACING old line(s) by new
* ------[ first line different ]------
20709 CALL QuickTPut1 ("Upload Successful.") ' UG070501
WasX$ = DATE$
ZWasZ$ = LEFT$(WasX$,6) + _
RIGHT$(WasX$,2)
StrewTo$ = ""
UCat$ = ""
* REPLACING old line(s) by new
* ------[ first line different ]------
20710 CALL QuickTPut1 ("Please Describe " + ZFileNameHold$ + _
" (Begin with '/' if for SysOp Only)") ' UG070501
CALL QuickTPut1 (LEFT$(" |----+--(Min---+---2+0---+---3+0---+---4+0---+-", _
ZMaxDescLen - 4) + "--Max)") ' UG070501
CALL QuickTPut ("? ",0)
ZOutTxt$ = ""
ZSubParm = 1
ZParseOff = ZTrue
CALL UglyTGet ' UG070501
CALL Carrier
IF ZSubParm = -1 THEN _
ZUserIn$ = "<description unavailable>": _
GOTO 20712
IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 10 THEN _
CALL QuickTPut1 ("10 Chars Min," + STR$(ZMaxDescLen) + " Max.") : _ ' UG070501
GOTO 20710
* REPLACING old line(s) by new
20717 CALL FindItX (ZNodeWorkFile$,7)
ZUserIn$ = Desc$
WasX$ = DATE$
ZWasZ$ = LEFT$(WasX$,6) + _
RIGHT$(WasX$,2)
ZWasEN$ = ZPersonalDir$
NumPersonals = 0
IF NOT ZOK THEN _
GOTO 20718
UserFileIndexSave = ZUserFileIndex
UserRecordHold$ = ZUserRecord$
WHILE NOT EOF(7)
CALL ReadParmsX (7,ZWorkAra$(),2,1)
IF LEFT$(ZWorkAra$(1),4) <> "ALL " AND ZWorkAra$(1) <> "ALL" THEN _
NumPersonals = NumPersonals + 1 : _
UCat$ = ZWorkAra$(1) : _
GOSUB 20728 : _
RcvrRecNum = VAL (ZWorkAra$(2)) : _
* ------[ first line different ]------
CALL SetUserFlag (RcvrRecNum,4096,"File") ' UG070501
WEND
CLOSE 7
IF NumPersonals > 0 THEN _
ZUserFileIndex = UserFileIndexSave : _
LSET ZUserRecord$ = UserRecordHold$ : _
GOTO 20723
* REPLACING old line(s) by new
* ------[ first line different ]------
20720 ZOutTxt$= "Put Upload in What File Category (D)efault, H)elp)" ' UG070501
ZSubParm = 1 ' UG070501
CALL UglyTGet ' UG070501
CALL AraAllCaps (ZUserIn$(),1)
IF ZSubParm = -1 OR ZUserIn$(1) = "D" THEN _
UCat$ = ZDefaultCatCode$ : _
GOTO 20722
IF ZWasQ = 0 THEN _
GOTO 20719
IF ZUserIn$(1) = "H" OR _
ZUserIn$(1) = "*" OR _
ZUserIn$(1) = "?" THEN _
GOTO 20719
CALL SearchArray (ZUserIn$(1),ZCategoryName$(),ZNumCategories,Found)
IF Found > 0 THEN _
UCat$ = ZCategoryCode$(Found) : _
IF LEN(UCat$) > 0 AND LEN(UCat$) < 4 AND INSTR(UCat$,",") = 0 THEN _
GOTO 20722
UCat$ = ""
IF NOT ZLimitSearchToFMS THEN _
StrewTo$ = ZDirPath$ + _
ZUserIn$(1) + _
"." + _
ZDirExtension$ : _
CALL FindIt (StrewTo$) : _
IF ZOK THEN _
GOTO 20722 _
ELSE CALL WordInFile (ZUpcatHelp$,ZUserIn$(1),ZOK) : _
IF ZOK THEN _
GOTO 20722
StrewTo$ = ""
CALL QuickTPut2 ("Unknown Category. Try Again.") ' UG070501
GOTO 20719
* REPLACING old line(s) by new
20722 IF ZUserSecLevel >= ZAskExtendedDesc AND _
ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _
* ------[ first line different ]------
ZOutTxt$ = "Add an Extended Description ([Y],N)" : _ ' UG070501
ZTurboKey = -ZTurboKeyUser : _
ZSubParm = 1 : _
CALL UglyTGet : _ ' UG070501
IF ZSubParm <> -1 THEN _
IF NOT ZNo THEN _
ZGetExtDesc = ZTrue : _
EXIT SUB
* REPLACING old line(s) by new
20727 ZWasDF$ = " >> uploaded << "
ZUplds = ZUplds + 1
ZGlobalUplds = ZGlobalUplds + 1
ZULBytes! = ZULBytes! + ZBytesInFile#
ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile#
CALL Muzak (7)
CALL TimeRemain (MinsRemaining)
MinsToAdd = WasX! / 60
CALL ChkAddedTime (MinsToAdd)
WasX! = MinsToAdd * 60!
ZTimeCredits! = ZTimeCredits! + WasX!
ZSecsPerSession! = ZSecsPerSession! + WasX!
IF ZPrivateDoor THEN _
WasX! = (WasX! - ZWasQ!) / 60 _
ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0
WasX$ = STR$(FIX(WasX!*10.0))
WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1)
IF WasX! > 1 THEN _
* ------[ first line different ]------
CALL QuickTPut1 ("Upload Increased Your Time Online by"+WasX$+" Minutes.") ' UG070501
CALL QuickTPut2 ("Thanks for the Upload!") ' UG070501
ZGetExtDesc = ZFalse
ZPrivateDoor = ZFalse
EXIT SUB
* REPLACING old line(s) by new
20728 ' ---[ lock file ]---
IF ZWasEN$ = "" THEN _
RETURN
FMSFormat = ZFalse
IF (ZWasEN$ = ZFMSDirectory$ OR ZLimitSearchToFMS _
OR NumPersonals > 0 OR (ZPrivateDoor AND ZFMSDoor)) THEN _
FMSFormat = ZTrue _
ELSE CALL FindIt (ZWasEN$) : _
IF ZOK THEN _
CALL ReadDir (2,1) : _
IF ZErrCode = 0 THEN _
FMSFormat = (LEFT$(ZOutTxt$,4) = "\FMS")
IF NOT FMSFormat THEN _
ReadBackwards = ZFalse : _
FixedLen = 0 : _
ZUserIn$ = Desc$ : _
GOTO 20729
* ------[ first line different ]------
FixedLen = 34 + ZMaxDescLen
IF NumPersonals > 0 THEN _
WasX$ = "*" : _
MaxLen = ZPersonalLen _
ELSE MaxLen = 3 : _
WasX$ = ""
UCat$ = LEFT$(UCat$,MaxLen)
UCat$ = UCat$ + SPACE$(MaxLen - LEN(UCat$))
ZUserIn$ = Desc$ + _
SPACE$(ZMaxDescLen - LEN(Desc$)) + _
UCat$ + WasX$
ReadBackwards = ZTrue
CALL FindIt (ZWasEN$)
IF ZOK THEN _
CALL ReadDir (2,1) : _
IF ZErrCode = 0 THEN _
ReadBackwards = (INSTR(ZOutTxt$," TOP ") = 0)
* REPLACING old line(s) by new
21110 IF ZLibDiskChar$ = "0000" THEN _
ZOutTxt$ = "No Library disk currently selected" _
ELSE ZOutTxt$ = "Library disk " + _
ZLibDiskChar$ + _
" selected - " + _
DiskTitle$
CALL QuickTPut1 (ZOutTxt$)
IF LibDiskArc$ = "" THEN _
EXIT SUB
IF INSTR(ZLibArcProgram$,"ARC") THEN _
Extension$ = "ARC" _
ELSE IF INSTR(ZLibArcProgram$,"ZIP") THEN _
Extension$ = "ZIP" _
ELSE IF INSTR(ZLibArcProgram$,"LHA") THEN _
Extension$ = "LZH" _
ELSE IF INSTR(ZLibArcProgram$,"ARJ") THEN _
Extension$ = "ARJ" _
ELSE Extension$ = ZDefaultExtension$
FOR LibDisplayCount = 0 TO LibLoopCount - 1
IF LibSubdirName$(LibDisplayCount) <> "" THEN _
CALL QuickTPut1 (LibSubdirName$(LibDisplayCount) + _
* ------[ first line different ]------
"." + Extension$ + " is Ready for Transmission.") ' UG070501
NEXT
EXIT SUB
* REPLACING old line(s) by new
21115 IF ZWasQ = 1 THEN _
* ------[ first line different ]------
ZOutTxt$ = "Change Library Disk from " + _ ' UG070501
ZLibDiskChar$ + _
" to (1 -" + _
STR$(ZLibMaxDisk) + _
")" : _
ZSubParm = 1 : _
CALL UglyTGet : _ ' UG070501
IF ZSubParm = -1 THEN _
EXIT SUB _
ELSE IF ZWasQ = 0 THEN _
ZLibDiskChar$ = "0000" : _
ChdirLib$ = ZLibDrive$ + _
"\" : _
GOTO 21126
* REPLACING old line(s) by new
21130 IF ZLibType <> 1 THEN _
EXIT SUB
CALL SkipLine(1)
* ------[ first line different ]------
ZOutTxt$ = "The PC-SIG Library File That You Are About to" ' UG070501
CALL QuickTPut1 (ZOutTxt$)
ZOutTxt$ = "Download Can Also be Ordered as Disk " + _ ' UG070501
ZLibDiskChar$
CALL QuickTPut1 (ZOutTxt$)
ZOutTxt$ = "from PC-SIG, 1030D East Duane Ave. Sunnyvale, Ca. 94086"
CALL QuickTPut (ZOutTxt$,2)
EXIT SUB
* REPLACING old line(s) by new
21140 IF ZLibDiskChar$ = "0000" THEN _
* ------[ first line different ]------
CALL QuickTPut1 ("No Library Disk Selected.") : _ ' UG070501
EXIT SUB
ZOutTxt$ = "Archive files in Library Disk - " + _
ZLibDiskChar$ + _
" for Download (Y,[N])" ' UG070501
ZSubParm = 1 ' UG070501
CALL UglyTGet ' UG070501
IF NOT ZLocalUser THEN _
IF ZSubParm = -1 THEN _
EXIT SUB
IF NOT ZYes THEN _
EXIT SUB
* REPLACING old line(s) by new
* ------[ first line different ]------
21150 CALL QuickTPut1 ("Work/RAM Disk Purged. Archiving with " + _
ZLibArcProgram$ + _
". Please Wait...") ' UG070501
REDIM LibSubdirName$(10)
LibSubdirChar$ = ""
LibLoopCount = 0
GOSUB 21157
ZOutTxt$ = "Contents of Library disk - " + _
ZLibDiskChar$ + _
" is Now Archived for Download." ' UG070501
CALL QuickTPut1 (ZOutTxt$)
ZOutTxt$ = "Searching for Subdirectories..." ' UG070501
CALL QuickTPut1 (ZOutTxt$)
GOSUB 21158
LibDiskArc$ = ZLibDiskChar$
'
' SEARCH AND ARCHIVE ANY SUBDIRECTORIES
'
Treedir$ = ZLibWorkDiskPath$ + _
ZLibNodeID$ + _
"DKDIR.LST"
DirCmd$ = "DIR " + _
ZLibDrive$ + _
" | FIND " + _
CHR$(34) + _
" <DIR> " + _
CHR$(34) + _
" > " + _
Treedir$
* REPLACING old line(s) by new
21153 CALL OpenWork (2,Treedir$)
LibSubdirCount = 0
WHILE NOT EOF(2)
LINE INPUT #2, Dirrec$
IF LEFT$(Dirrec$,1) <> "." THEN _
LibSubdirCount = LibSubdirCount + 1 : _
LibSubdirName$(LibSubdirCount) = _
LEFT$(Dirrec$,8)
WEND
CLOSE 2
LibLoopCount = 1
IF LibSubdirCount = 0 THEN _
GOTO 21156
ZOutTxt$ = STR$(LibSubdirCount) + _
* ------[ first line different ]------
" Subdirectories on Library Disk - " + _ ' UG070501
ZLibDiskChar$
CALL QuickTPut1 (ZOutTxt$)
FOR LibLoopCount = 1 TO LibSubdirCount
IF NOT ZLocalUser THEN _
CALL Carrier : _
IF ZSubParm THEN _
GOTO 21155
LibSubdirChar$ = MID$("ABCDEFGHI",LibLoopCount,1)
ZOutTxt$ = "Creating " + _
ZLibNodeID$ + _
"DK" + _
ZLibDiskChar$ + _
LibSubdirChar$ + "." + Extension$ + _
" using " + ZLibArcProgram$
CALL QuickTPut1 (ZOutTxt$)
CHDIR ChdirLib$ + _
"\" + _
LibSubdirName$(LibLoopCount)
GOSUB 21157
ZOutTxt$ = "Disk - " + _
ZLibDiskChar$ + _
"; Subdirectory" + _
" -" + _
STR$(LibLoopCount) + _
" is Archived for Download." ' UG070501
CALL QuickTPut1 (ZOutTxt$)
GOSUB 21158
* REPLACING old line(s) by new
21604 ZStopInterrupts = ZTrue
IF Index = 3 THEN _
IF ZAnsIndex < ZLastIndex THEN _
GOTO 21605
CALL QuickTPut1 (WasX$)
CALL BufString (ZTransferOption$,4096,WasX)
* ------[ first line different ]------
CALL QuickTPut (MID$("?:",1-ZTurboKeyUser,1)+" ",0) ' UG070501
* REPLACING old line(s) by new
21605 ZOutTxt$ = ""
ZTurboKey = -ZTurboKeyUser
ZMacroMin = 2
ZSubParm = 1
ZSuspendAutoLogoff = ZTrue
ZStackC = ZTrue
IF Index = 3 THEN _
* ------[ first line different ]------
CALL UglyPopCmdStack : _ ' UG070501
WasX = ZAnsIndex _
ELSE ZSubParm = 1 : _
CALL UglyTGet : _ ' UG070501
WasX = 1
ZSuspendAutoLogoff = ZFalse
IF ZSubParm = -1 THEN _
EXIT SUB
IF ZWasQ = 0 THEN _
GOTO 21604
* REPLACING old line(s) by new
31399 IF ZFunctionKey = 22 THEN _
CALL SkipLine (2) : _
* ------[ first line different ]------
CALL QuickTPut1 ("Sorry, SysOp Needs the System Now.") : _ ' UG070501
CALL DelayTime (8 + ZBPS) : _
ZSubParm = -6 : _
GOTO 33970
CALL QuickTPut1 (ZFirstName$ + ", Goodbye and DON'T Call Back!") ' UG070501
CALL DelayTime (8 + ZBPS) : _
IF ZUserFileIndex < 1 THEN _
ZSubParm = -6 : _
GOTO 33970
ZUserSecLevel = ZMinLogonSec - 1
CALL DenyAccess
ZSubParm = -7
GOTO 33970
'
'
' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)
'
'
* REPLACING old line(s) by new
32000 IF NOT ZLocalUser THEN _
* ------[ first line different ]------
CALL SkipLine (2) : _ ' UG070501
CALL QuickTPut1 ("SysOp Exiting to DOS. Please Wait...") : _ ' UG070501
ZFunctionKey = 0 : _
CALL DelayTime (3)
CALL ShellExit (ZDiskForDos$ + "COMMAND")
'SHELL ZDiskForDos$ + _
' "COMMAND"
CLS
IF NOT ZLocalUser THEN _
CALL Carrier : _
IF ZSubParm = -1 THEN _
GOTO 33970
ZSubParm = 2
CALL Line25
CALL QuickTPut1 ("SysOp Back from DOS. Returning Control to You.") ' UG070501
ZCommPortStack$ = ZCarriageReturn$
GOTO 33970
'
'
' * F3 - COMMAND FROM LOCAL KEYBOARD (Printer Toggle)
'
'
* REPLACING old line(s) by new
33160 CALL UpdtCalr ("Sysop began chat",1)
ZPageStatus$ = ""
* ------[ first line different ]------
CALL SkipLine (2) ' UG070501
ZOutTxt$ = ZSysopFirstName$ + " " + ZSysopLastName$ ' UG070501
CALL NameCaps(ZOutTxt$) ' UG070501
CALL QuickTPut1 ("Hi, This is " + _
ZOutTxt$ + _
". Sorry to Break in to Chat, But...") ' UG070501
CALL TimeBack (1)
CALL SysopChat
CALL TimeBack (2)
ZCommPortStack$ = CHR$(13)
GOTO 33155
'
'
' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
'
'
* REPLACING old line(s) by new
41010 ' $SUBTITLE: 'TimeRemain - calculates time remaining in a session'
' $PAGE
'
' NAME -- TimeRemain
'
' INPUTS -- PARAMETER MEANING
' ZUserLogonTime! WHEN DID THE CALLER GET HERE
' ZSecsPerSession! HOW LONG MAY THE CALLER STAY ON
' ZTimeToDropToDos! WHEN ARE WE DOING OUR DAILY EVENT
' ZBypassTimeCheck DO WE CARE HOW LONG THEY CAN STAY
'
' OUTPUTS -- PARAMETER MEANING
' MinsRemaining TIME IN MINUTES LEFT IN SESSION
' ZSecsUsedSession! TIME USED IN SECONDS
'
SUB TimeRemain (MinsRemaining) STATIC
TOA! = FRE("A")
IF ZBypassTimeCheck THEN _
MinsRemaining = ZSecsPerSession! / 60 : _
EXIT SUB
CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
IF ZTimeToDropToDos! = 0 OR _
ZOldDate$ = DATE$ THEN _
GOTO 41020
CALL CheckTime (ZTimeToDropToDos!, HowMuchTimeLeft!, 1)
IF HowMuchTimeLeft! < -60 THEN _
HowMuchTimeLeft! = (HowMuchTimeLeft! * -1) + 43200
IF (ZSecsPerSession! - ZSecsUsedSession!) > HowMuchTimeLeft! THEN _
ZSecsPerSession! = HowMuchTimeLeft! + ZSecsUsedSession! : _
IF NOT ToldShort THEN _
ToldShort = ZTrue : _
* ------[ first line different ]------
ZOutTxt$ = "Session Time Shortened to" + _
STR$(INT((ZSecsPerSession! - ZSecsUsedSession!) / 60)) + _
" Minutes Due to a Scheduled Event." : _ ' UG070501
CALL RingCaller
* REPLACING old line(s) by new
41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining'
' $PAGE
'
' NAME -- DispTimeRemain
'
' INPUTS -- PARAMETER MEANING
' MinsRemaining
'
' OUTPUTS -- PARAMETER MEANING
' MinsRemaining TIME IN MINUTES LEFT IN SESSION
'
SUB DispTimeRemain (MinsRemaining) STATIC
CALL TimeRemain (MinsRemaining)
* ------[ first line different ]------
CALL QuickTPut1 (ZEmphasizeOff$ + STR$(MinsRemaining) + " Mins Left") ' UG070501
END SUB
* REPLACING old line(s) by new
* ------[ first line different ]------
43007 CALL QuickTPut1 ("Graphics for Text Files and Menus.") ' UG070501
ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, IBM A)scii, ANSI C)olor, H)elp" + ZPressEnterExpert$ ' UG070501
ZTurboKey = -ZTurboKeyUser
CALL UglyPopCmdStack ' UG070501
IF ZSubParm = -1 OR ZWasQ = 0 THEN _
EXIT SUB
' IF ZWasQ = 0 THEN _ ' UG070501
' CALL QuickTPut2 ("Unchanged") : _ ' UG070501
' EXIT SUB ' UG070501
CALL AraAllCaps (ZUserIn$(),ZAnsIndex)
ZWasGR = INSTR("NAC",ZUserIn$(ZAnsIndex))
IF ZWasGR = 2 AND NOT ZEightBit THEN _
CALL QuickTPut1 ("Ascii Graphics Unavailable. Requires N,8,1.") : _ ' UG070501
GOTO 43007
IF ZWasGR = 0 THEN _
GOTO 43006
ZWasGR = ZWasGR - 1
CALL SetGraphic (ZWasGR)
END SUB
'
* REPLACING old line(s) by new
* ------[ first line different ]------
57002 CALL QuickTPut1 ("Available Callers Logs Are:") ' UG070501
ZNo = ZFalse
LineCt = 0
CALL OpenWork (2, ZCallersLst$)
WHILE (NOT ZNo) AND (NOT EOF(2))
LineCt = LineCt + 1
CALL ReadDir (2,1)
Temp = INSTR(ZOutTxt$," ")
IF Temp = 0 THEN _
ZOutTxt$ = " ???" _
ELSE ZOutTxt$ = MID$(ZOutTxt$,Temp)
ZOutTxt$ = " " + STR$(LineCt) + " - " + ZOutTxt$
ZSubParm = 5
CALL TPut
CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
WEND
* REPLACING old line(s) by new
* ------[ first line different ]------
57003 ZOutTxt$ = "View Which Callers Log, L)ist, [Q]uit" ' UG070501
CALL UglyPopCmdStack ' UG070501
WasDF$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (WasDF$)
IF WasDF$ = "L" THEN _
GOTO 57002
CALL CheckInt (WasDF$)
IF ZTestedIntValue <= 0 THEN _
GOTO 57102
IF ZTestedIntValue > NumItems THEN _
GOTO 57003
CALL OpenWork (2,ZCallersLst$)
CALL ReadDir (2, ZTestedIntValue)
ZCallersFile$ = LEFT$(ZOutTxt$,INSTR(ZOutTxt$+" "," ")-1)
CALL FindIt (ZCallersFile$)
CLOSE 2
IF NOT ZOK THEN _
Call QuickTPut2 ("Callers Log "+ZCallersFile$+" Missing.") : _ ' UG070501
ZCallersFile$ = PrevCal$ : _
GOTO 57003
IF PrevCal$ <> ZCallersFile$ THEN _
CALL SetCall
* REPLACING old line(s) by new
57102 ZJumpSupported = ZFalse
IF OrigCal$ <> ZCallersFile$ THEN _ ' RH070401
ZCallersFile$ = OrigCal$ : _
CALL SetCall
* ------[ first line different ]------
CALL SkipLine (1) ' UG070501
END SUB
* REPLACING old line(s) by new
58110 ' $SUBTITLE: 'CheckNewBul - sub to check whether got new bulletins'
' $PAGE
'
' NAME -- CheckNewBul
'
' INPUTS -- PARAMETER MEANING
' LastOn$ Last DATE OF LOGON
' FORMAT MM/DD/YY
' ZActiveBulletins # OF BULLETING
' ZBulletinPrefix$ FILESPEC FOR BULLETINS
'
' OUTPUTS -- NumNewBullets NUMBER OF NEW BULLETINS
' NewBullets$ LIST OF NEW BULLET #'S
' ZWasQ WHERE Last BULLETIN STORED
' IN ZUserIn$()
' ZOutTxt$() BULLETINS #'S THAT ARE NEW
' (2,3,4,...)
'
' PURPOSE -- Checks how many bulletins have system date
' at or later than date caller last logged on
'
SUB CheckNewBul (LastOn$,NumNewBullets,NewBullets$) STATIC
IF ZExitToDoors OR ZBulletinPrefix$ = ZPrevPrefix$ THEN _
EXIT SUB
ZPrevPrefix$ = ZBulletinPrefix$
NumNewBullets = 0
NewBullets$ = ""
BaseDate# = VAL(MID$(LastOn$,4,2)) + (100 * VAL(MID$(LastOn$,1,2))) + _
(10000# * (1900 + VAL(MID$(LastOn$,7,2))))
CALL FindIt (ZBulletinPrefix$ + ".FCK")
WasX = 0
* ------[ first line different ]------
CALL QuickTPut ("Checking For New Bulletins",0) ' UG070501
IF ZOK THEN _
WHILE NOT EOF(2) : _
INPUT #2,WasBN$ : _
GOSUB 58112 : _
WEND _
ELSE FOR WasI = 1 TO ZActiveBulletins : _
WasBN$ = MID$(STR$(WasI),2) : _
GOSUB 58112 : _
NEXT
ZWasQ = NumNewBullets + 1
CALL WipeLine(33) ' UG070501
IF NumNewBullets < 1 THEN _ ' UG070501
CALL QuickTput1 ("There Are No New Bulletins.") : _ ' UG070501
EXIT SUB ' UG070501
ZOutTxt$ = "There Are" + STR$(NumNewBullets) + _ ' UG070501
" New Bulletins:" ' UG070501
CALL QuickTPut1 (ZOutTxt$)
CALL BufString (NewBullets$,4096,WasX)
CALL SkipLine (1)
EXIT SUB
* REPLACING old line(s) by new
58150 ' $SUBTITLE: 'CountNewFiles - sub to count how many files new'
' $PAGE
'
' NAME -- CountNewFiles
'
' INPUTS -- PARAMETER MEANING
' LastOn$ Date of last logon
' UPLDS$ Latest uploads
'
' OUTPUTS -- NumNewFiles How many after last logon
' RptPrefix$ Set to "At least " if
' above is a minimum
'
' PURPOSE -- Checks how many files in UPLDS$ were uploaded on or
' after date of last logon that the user can download
'
* ------[ first line different ]------
SUB CountNewFiles (LastOn$,Upld(2),NumUserFiles,Text$) STATIC ' UG070501
BaseDate = 372 * (VAL(MID$(LastOn$,7,2)) - 80) + _
31 * (VAL(MID$(LastOn$,1,2))) + _
VAL(MID$(LastOn$,4,2))
NumNewFiles = 1
NumUserFiles = 0
WHILE (BaseDate <= Upld(NumNewFiles,1) AND _
Upld(NumNewFiles,1) > 0 AND _
NumNewFiles < UBOUND(Upld,1))
IF ZUserSecLevel => Upld(NumNewFiles,2) THEN _
NumUserFiles = NumUserFiles + 1
NumNewFiles = NumNewFiles + 1
WEND
IF Upld(NumNewFiles,1) < 1 THEN _
NumNewFiles = NumNewFiles - 1
IF BaseDate <= Upld(NumNewFiles,1) AND NumNewFiles > 0 THEN _ ' UG070504
Text$ = " At Least" _ ' UG070501
ELSE Text$ = "" ' UG070501
IF NumNewFiles = 0 THEN _ ' UG070501
Text$ = Text$ + " No" _ ' UG070501
ELSE _ ' UG070501
Text$ = Text$ + STR$(NumNewFiles) ' UG070501
END SUB
* REPLACING old line(s) by new
58162 ' $SUBTITLE: 'InitFMS - sub to initialize file management system'
' $PAGE
'
' NAME -- InitFMS
'
' INPUTS -- PARAMETER MEANING
' ZFMSDirectory$
'
' OUTPUTS -- ZCategoryName$() ELEMENTS 1,2, POSSIBLY MORE
' ZCategoryCode$() ELEMENTS 1,2, POSSIBLY MORE
' ZCategoryDesc$() ELEMENTS 1,2, POSSIBLY MORE
' CategoryIndex COUNT OF # ELEMENTS IN THE FILE
' MANAGMENT SYSTEM
'
' PURPOSE -- Subroutine to initialize the RBBS-PC File Management System
'
SUB InitFMS (CategoryIndex) STATIC
Blank$ = " "
CategoryIndex = 1
ZCategoryName$(1) = "P"
ZCategoryCode$(1) = "P"
* ------[ first line different ]------
ZCategoryDesc$(1) = "Personal Files" ' UG070501
IF ZFMSDirectory$ <> "" THEN _
CategoryIndex = CategoryIndex + 1 : _
CatN$ = ZCategoryName$(CategoryIndex) : _
CALL BreakFileName (ZFMSDirectory$,DrvPath$,CatN$,Extension$,ZFalse) : _
ZCategoryName$(CategoryIndex) = CatN$ : _
ZCategoryCode$(CategoryIndex) = "" : _
ZCategoryDesc$(CategoryIndex) = "All Uploads"_ ' UG070501
ELSE ZLimitSearchToFMS = ZFalse : _
EXIT SUB
IF ZLimitSearchToFMS OR ZMasterDirName$ = ZMainFMSDir$ THEN _
CategoryIndex = CategoryIndex + 1 : _
ZCategoryName$(CategoryIndex) = "ALL" : _
ZCategoryCode$(CategoryIndex) = "" : _
ZCategoryDesc$(CategoryIndex) = "All Files" ' UG070501
CALL FindIt (ZDirCatFile$)
IF NOT ZOK THEN _
EXIT SUB
WHILE NOT EOF(2)
CALL ReadParms (ZWorkAra$(),3,1)
IF ZErrCode > 0 THEN _
ZErrCode = 0 : _
CALL PScrn (ZDirCatFile$+" invalid. Line" + STR$(CategoryIndex) + " needs 3 parms") : _
CALL DelayTime (4) _
ELSE CategoryIndex = CategoryIndex + 1 : _
ZCategoryName$(CategoryIndex) = ZWorkAra$(1) : _
CALL AraAllCaps (ZCategoryName$(),CategoryIndex) : _
ZCategoryCode$(CategoryIndex) = ZWorkAra$(2) : _
ZCategoryDesc$(CategoryIndex) = ZWorkAra$(3) : _
CatR$ = ZCategoryCode$(CategoryIndex) : _
CALL Remove (CatR$,Blank$) : _
ZCategoryCode$(CategoryIndex) = CatR$
WEND
CLOSE 2
END SUB
* REPLACING old line(s) by new
58165 ' $SUBTITLE: 'DispUpDir - sub to display FMS directory'
' $PAGE
'
' NAME -- DispUpDir
'
' INPUTS -- PARAMETER MEANING
' PassedCats$ FILE "CATEGORIES" TO BE INCLUDED IN
' THE SEARCH.
' SearchString$ STRING TO SEARCH ON WITHIN THE
' FILE "CATEGORIES" SELECTED
' SearchDate$ DATE EQUAL TO OR GREATER THAN TO BE
' SEARCHED FOR WITH THE "CATEGORIES"
' AND THE STRING TO SEARCH.
' DnldFlag SET TO RECORD # OF LINE TO BEGIN
' VIEWING - 0 IF AT END
'
' OUTPUTS -- DnldFlag WHENEVER DOWNLOAD REQUESTED, SETS
' TO 1. OTHERWISE LEAVES AT ZERO
' PURPOSE -- Display the files that meet the criteria selected in
' RBBS-PC upload management system on the users screen.
'
SUB DispUpDir (PassedCats$,SearchString$, _
SearchDate$,DnldFlag,AbortIndex) STATIC
IF AtEndList THEN _
AtEndList = ZFalse : _
IF DnldFlag > 0 THEN _
GOSUB 58185 : _
GOTO 58184
CALL AllCaps (SearchString$)
Blank$ = " "
ZStopInterrupts = ZFalse
Categories$ = "," + _
PassedCats$ + _
","
CanDnld = (ZUserSecLevel => ZOptSec(19))
CanView = (ZUserSecLevel => ZOptSec(26))
ZJumpSupported = ZTrue
ZJumpSearching = ZFalse
GOSUB 58185
OrigDir$ = ZActiveFMSDir$
InList = (RelistAt > 0 AND ReListAt <= LastRec)
IF InList AND DnldFlag > 0 THEN _
UpldIndex = RelistAt : _
DnldFlag = 0 : _
GOTO 58179
ZJumpLast$ = ""
SearchFor$ = SearchString$
* ------[ first line different ]------
ExtraPrompt$ = "" ' UG070501
IF CanView THEN _ ' UG070501
ExtraPrompt$ = ",V)iew" ' UG070501
IF ZPersonalDnld THEN _ ' UG070501
ExtraPrompt$ = ExtraPrompt$ + ",*)D/L New" ' UG070501
IF CanDnld THEN _ ' UG070501
ExtraPrompt$ = ExtraPrompt$ + ",M)ark,D)ownload" ' UG070501
MaxPrint = ZPageLength - 1
BelowMinSec = (ZUserSecLevel < ZMinSecToView)
ZNonStop = ZNonStop OR (ZPageLength < 1)
FMSCheckPoint = 0
WildSearch = (INSTR(SearchString$,"?") > 0) _
OR (INSTR(SearchString$,"*") > 0)
CALL AraAllCaps (ZUserIn$(),ZAnsIndex)
'print "zansindex=";zansindex;" zlastindex=";zlastindex;:for ii=zansindex to zlastindex: print "<";zuserin$(ii);">";:next:print " zlc=<";zlastcommand$;">";:print:INPUT XXX$
IF ZAnsIndex > 0 THEN _
IF ZLastCommand$ = "FP" AND INSTR("Ll",ZUserIn$(ZLastIndex)) = 0 THEN _
ZUserIn$(ZAnsIndex) = "D" : _
IF (UpldIndex > 0 AND UpldIndex <= LastRec) THEN _
GOTO 58180 _
ELSE Temp$ = "" : _
GOTO 58196
* REPLACING old line(s) by new
58170 IF ZExtendedOff THEN _ ' Extended description
GOTO 58168 _
* ------[ first line different ]------
ELSE IF LastOK OR ZPersonalDnld THEN _ ' UG070506
GOTO 58175 _
ELSE IF ZJumpSearching THEN _
GOTO 58187 _
ELSE IF SearchString$ <> "" AND (NOT WildSearch) AND FailedSearch THEN _
GOTO 58187 _
ELSE GOTO 58168
* REPLACING old line(s) by new
* ------[ first line different ]------
58171 IF Category$ = "***" OR ZPersonalDnld THEN _ ' display line ' UG070506
GOTO 58176 _
ELSE HoldCat$ = "," + Category$ + "," : _
IF INSTR(Categories$,HoldCat$) > 0 THEN _
GOTO 58176 _
ELSE GOTO 58168
* REPLACING old line(s) by new
58178 IF ZLinesPrinted <= MaxPrint AND (FMSCheckPoint MOD 1000 <> 0) THEN _
GOTO 58168
CALL CheckCarrier
IF ZSubParm = -1 THEN _
GOTO 58198
CALL TimeRemain (MinsRemaining)
IF MinsRemaining <= 0 THEN _
ZSubParm = -1 : _
GOTO 58198
IF ZNonStop THEN _
GOTO 58168
IF ZLinesPrinted <= MaxPrint THEN _
IF ZDateOrderedFMS THEN _
CALL QuickTPut1 (ZEmphasizeOff$ + _
* ------[ first line different ]------
"Files Checked Through " + MID$(PartToPrint$,24,8) + ".") _ ' UG070501
ELSE _
CALL QuickTPut1 (ZEmphasizeOff$ + STR$(FMSCheckPoint) + _
" Files Checked.") ' UG070501
* REPLACING old line(s) by new
58180 WasX$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (WasX$)
IF InList AND (ZAnsIndex >= ZLastIndex OR WasX$ <> "D") THEN _
ZTurboKey = -ZTurboKeyUser : _
ZStackC = ZTrue : _
CALL AskMore (ExtraPrompt$, ZTrue, ZFalse,AbortIndex,ZFalse) : _
IF ZSubParm = -1 THEN _
EXIT SUB _
ELSE ZLastIndex = ZWasQ :_
IF NOT ZNo THEN _
ZAnsIndex = 1
IF ZSubParm = -1 THEN _
GOTO 58198
IF ZNo THEN _
ZLastIndex = 0 : _
* ------[ first line different ]------
CALL QuickTPut1 (ZEmphasizeOff$) : _ ' UG070501
GOTO 58198
WasX$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (WasX$)
'print "WASX$=<";WASX$;"> zansindex=";zansindex;" zlastindex=";zlastindex;:for ii=zansindex to zlastindex: print "<";zuserin$(ii);">";:next:print:INPUT XXX$
IF WasX$ = "V" THEN IF CanView THEN _
CALL GetArc : _
ZJumpSupported = ZTrue : _
ZWasA = UpldIndex : _
GOSUB 58185 : _
UpldIndex = ZWasA : _
GOTO 58180
'print "wasx$=<";wasx$;"> candnld=";candnld;" zlc=<";zlastcommand$;"> inlist=";inlist
* REPLACING old line(s) by new
58181 MarkingFiles = ZFalse
IF (WasX$ = "D" OR WasX$ = "M") THEN IF CanDnld THEN _
MarkingFiles = (WasX$ = "M") : _
* ------[ first line different ]------
CALL AskItems ("DM",WasX$,ZTrue,"File",ZMarkedFiles$) : _ ' UG070501/KG062401
IF ZWasQ = 0 THEN _
GOTO 58183
IF WasX$ = "*" THEN IF ZPersonalDnld THEN _
GOTO 58193
* REPLACING old line(s) by new
58183 IF ZJumpSearching THEN _
PrevSearch$ = SearchFor$ : _
SearchFor$ = ZJumpTo$ _
ELSE SearchFor$ = SearchString$ : _
IF NOT ZYes AND CanDnld THEN _
GOSUB 58188 : _
IF WasX$ <> "L" AND ZLastIndex >= ZAnsIndex AND NOT MarkingFiles THEN _
* ------[ first line different ]------
DnldFlag = 1 : _
ReListAt = UpldIndex : _
EXIT SUB _ ' exit for downloading
ELSE IF UpldIndex = CutoffRec THEN _
GOTO 58184
IF ZNonStop THEN IF UpldIndex > 999 THEN _
IF (SearchDate$ = "" OR NOT ZExpertUser) THEN _
ZOutTxt$ = "There Are" + STR$(UpldIndex) + _
" Lines Left to Scan. Really Go Non-Stop (Y,[N])" : _ ' UG070501
ZNoAdvance = ZTrue : _
ZTurboKey = -ZTurboKeyUser : _
ZSubParm = 1 : _
CALL TGet : _
CALL WipeLine (79) : _
ZNonStop = ZYes
GOTO 58168
* REPLACING old line(s) by new
58184 IF ZChainedDir$ <> "" THEN _
ZActiveFMSDir$ = ZChainedDir$ : _
GOSUB 58185 : _
LastFName = 0 : _
GOTO 58168
'print "58184 ZNo=";zno;" zlistonly=";zlistonly
IF ZNo THEN _
* ------[ first line different ]------
CALL QuickTput1 (ZEmphasizeOff$) : _ ' UG070501
GOTO 58198
Temp$ = "End List. " ' UG070501
AtEndList = ZTrue
UpldIndex = CutOffRec - ZUpInc
ZLastIndex = 0
GOTO 58196
* REPLACING old line(s) by new
58188 IF ProcessedNew OR MarkingFiles OR NOT ZListOnly THEN _
ProcessedNew = ZFalse : _
RETURN
ZUserIn$(0) = ""
WasI = ZAnsIndex ' check whether in dir
WHILE WasI <= ZLastIndex
CALL AraAllCaps (ZUserIn$(),WasI)
ZWasZ$ = ZUserIn$(WasI)
CALL UnMarkItems (ZMarkedFiles$,WasI,ZLastIndex,WasX,ZTrue)
* ------[ first line different ]------
CALL AllCaps (ZUserIn$(WasI)) ' UG070512
ZWasZ$ = ZUserIn$(WasI) ' UG070512
Temp$ = ZUserIn$(WasI)
'print "wasi=";wasi;" temp$=<";temp$;"> Zdef=<";zdefaultxfer$;">"
IsProto = (LEN(Temp$) = 1 AND _
INSTR(ZDefaultXfer$,Temp$) > 0)
ZOK = IsProto
WasJ = LastRec + 1
WasX = INSTR(Temp$,".")
AltTemp$ = ""
IF NOT IsProto THEN _
IF WasX = 0 THEN _
AltTemp$ = Temp$ + "." + ZDefaultExtension$ _
ELSE IF WasX = LEN(Temp$) THEN _
AltTemp$ = LEFT$(Temp$,WasX-1)
'print "58188 b4 while zok=";zok;" wasj=";wasj;" looking for <";temp$;">"
WHILE WasJ > 1 AND NOT ZOK
WasJ = WasJ - 1
GET #2,WasJ
GOSUB 58191
'print "bk 58191 canget=";catget;" ptp<";parttoprint$;">";:input xx$
IF CanGet THEN _
MID$(PartToPrint$,13,1) = " " : _
WasX$ = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1) : _
ZOK = (Temp$ = WasX$) : _
IF NOT ZOK THEN _
IF AltTemp$ <> "" THEN _
ZOK = (AltTemp$ = WasX$)
WEND
'print "58188 aft while zok=";zok;" wasj=";wasj;" looking for <";temp$;">":input xxx$
IF ZOK THEN _
GOSUB 58189 : _
IF ZOK OR IsProto THEN _
WasX$ = MID$(STR$(WasJ),2) : _
ZUserIn$(0) = ZUserIn$(0) + _
WasX$ + _
SPACE$(5 - LEN(WasX$))
IF NOT ZOK AND NOT IsProto THEN _
CALL QuickTPut1 (ZWasZ$ + " Not Found - Omitted from Download.") : _ ' UG070501
FOR WasK = WasI + 1 TO ZLastIndex : _
ZUserIn$(WasK - 1) = ZUserIn$(WasK) : _
NEXT : _
ZLastIndex = ZLastIndex - 1 : _
WasI = WasI - 1
WasI = WasI + 1
WEND
ZWasQ = ZLastIndex
'print "end 58188 zlastindex=";zlastindex;" zok=";zok
RETURN
* REPLACING old line(s) by new
58194 PersIndex = PersIndex - 1
WEND
IF ZLastIndex = 0 THEN _
* ------[ first line different ]------
ZOutTxt$ = "Sorry, No New Files Found to You." : _ ' UG070501
CALL QuickTPut2 (ZOutTxt$) : _ ' UG070501
GOTO 58183
ZAnsIndex = 1
GOTO 58183
* REPLACING old line(s) by new
58196 CALL QuickTPut (ZEmphasizeOff$,0)
* ------[ first line different ]------
ZOutTxt$ = Temp$ + "L)ist Again, A)bort, " + _
LEFT$("*)D/L New, ",-11*ZPersonalDnld) + _
"M)ark" + LEFT$(", D)ownload",-11*CanDnld) + _
LEFT$(", V)iew",-7*CanView) + _
", [Q]uit" ' UG070501
ZTurboKey = -ZTurboKeyUser
CALL UglyPopCmdStack ' UG070501
WasX$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (WasX$)
IF WasX$ = "A" THEN ZRet = ZTrue
IF ZWasQ = 0 OR ZRet OR ZSubParm < 0 OR WasX$ = "Q" THEN _ ' UG070501
GOTO 58198
IF WasX$ = "L" THEN _
ZActiveFMSDir$ = OrigDir$ : _
GOSUB 58185 : _
AtEndList = ZFalse : _
GOTO 58168
IF WasX$ = "V" THEN IF CanView THEN _
CALL GetArc
ZYes = ZFalse
GOTO 58181
* REPLACING old line(s) by new
58198 CLOSE 2
ZNonStop = (ZPageLength < 1)
ZStopInterrupts = ZFalse
ZOutTxt$ = ""
ZActiveFMSDir$ = ""
ZJumpSupported = ZFalse
* ------[ first line different ]------
ZAnsIndex = ZLastIndex + 1 ' UG070501
DnldFlag = 0
EXIT SUB
END SUB